(with-open-file (st hn)
(si::copy-stream st *standard-output*))
(when *disassemble-objdump*
- (si::copy-stream (open (concatenate 'string "|objdump --source " (namestring on)))
- *standard-output*))
+ (with-open-file (s (concatenate 'string "|objdump --source " (namestring on)))
+ (si::copy-stream s *standard-output*)))
(delete-file cn)
(delete-file dn)
(delete-file hn)
# Need to get over default cstack and related maps between 0x1000000 and 0x2000000
if test "$use" == "386-gnu" || test "$use" == "amd64-gnu" ; then
- if test "$use" == "386-gnu" ; then
- q=24;
- else
- q=23;
- fi
+ q=24;
if test $min -lt $q && test $q -lt $max && test $q -lt 30; then
min=$q
{ printf '%s\n' "$as_me:${as_lineno-$LINENO}: min log text start increased to $min over c stack address" >&5
# Need to get over default cstack and related maps between 0x1000000 and 0x2000000
if test "$use" == "386-gnu" || test "$use" == "amd64-gnu" ; then
- if test "$use" == "386-gnu" ; then
- q=24;
- else
- q=23;
- fi
+ q=24;
if test $min -lt $q && test $q -lt $max && test $q -lt 30; then
min=$q
AC_MSG_NOTICE([min log text start increased to $min over c stack address])
-"Version_2_7_2pre32"
+"Version_2_7_2pre33"
#include "linux.h"
-#define ADDITIONAL_FEATURES \
- ADD_FEATURE("BSD386"); \
- ADD_FEATURE("MC68020")
-
-
#define I386
#define SGC
#undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/
/* #define NO_FILE_LOCKING */ /*FIXME*/
+
+#define ADDITIONAL_FEATURES ADD_FEATURE("NO-SIGFPE")
+
+#undef HAVE_FEENABLEEXCEPT
/* void sigint(),sigalrm(); */
-EXTER bool gc_enabled, saving_system;
+EXTER bool gc_enabled, saving_system,leak_malloc_p;
EXTER object lisp_package,user_package;
EXTER char *core_end;
EXTER long real_maxpage;
EXTER char *this_lisp;
-EXTER char stdin_buf[],stdout_buf[];
+#define EXTRA_BUFSIZE 8
+EXTER char stdin_buf[BUFSIZ + EXTRA_BUFSIZE];
+EXTER char stdout_buf[BUFSIZ + EXTRA_BUFSIZE];
+EXTER char stderr_buf[BUFSIZ + EXTRA_BUFSIZE];
EXTER object user_package;
massert(!close(pool));
pool=-1;
massert(!munmap(Pool,sizeof(struct pool)));
+ Pool=NULL;
memset(gcl_pool,0,sizeof(gcl_pool));
no_recur=0;
}
void * gcl_gmp_alloc(size_t);
-void init_gmp_rnd_state(__gmp_randstate_struct *);
+void init_gmp_rnd_state(__gmp_randstate_struct *,object);
int my_plt(const char *,unsigned long *);
fixnum elt_mode(fixnum);
-void init_gmp_rnd_state(__gmp_randstate_struct *);
-
-/* void set_sgc_bit(struct pageinfo *,void *); */
-
-void reinit_gmp(void);
-
object mod(object,object);
void intdivrem(object,object,fixnum,object *,object *);
void close_dlopen_list(void);
void set_global_env_defaults(void);
void disable_aslr(int,char **,char **);
+void set_leak_malloc_on(void);
+void set_leak_malloc_off(void);
(feclearexcept x)
(floating-point-error x (list* fun "unknown" name args) 0))))
(defun break-on-floating-point-exceptions
- (&key suspend no-flush
+ (&rest all
+ &key suspend no-flush
,@(mapcar (lambda (x) `(,(car x) (logtest ,(caddr x) fpe-enabled))) +fe-list+)
&aux r #+no-sigfpe(x (fetestexcept fpe-set)))
(fe-enable
(0)))
+fe-list+))))))
#+no-sigfpe
- (unless (or no-flush (zerop x)) (floating-point-error x 0 0))
+ (unless (or no-flush (zerop x))
+ (let ((y 'break-on-floating-point-exceptions))
+ (floating-point-error x (list (symbol-function y) "unknown" y all) 0)))
r))
(defun subclasses (class)
/* #endif */
bool writable_malloc=0;
+bool leak_malloc_p=1;
static void *malloc_pre_main_base,*malloc_pre_main_ptr,*malloc_pre_main_end;
+void
+set_leak_malloc_on(void) {
+
+ leak_malloc_p=1;
+
+}
+
+void
+set_leak_malloc_off(void) {
+
+ leak_malloc_p=0;
+ malloc_pre_main_base=malloc_pre_main_ptr=malloc_pre_main_end=NULL;
+
+}
+
static void *
-malloc_internal(size_t size) {
+leak_malloc(size_t size) {
- if (!msbrk_initialized()) {
- static bool recursive_malloc;
- unsigned long s=PAGESIZE;
+ unsigned long s=1<<14;
- massert(!recursive_malloc);
- recursive_malloc=1;
- if (!malloc_pre_main_base) {
- massert((malloc_pre_main_base=mmap(NULL,s,PROT_READ|PROT_WRITE,MAP_PRIVATE|MAP_ANON,-1,0))!=(void *)-1);
- malloc_pre_main_ptr=malloc_pre_main_base;
- malloc_pre_main_end=malloc_pre_main_base+s;
- }
- massert(size<=(malloc_pre_main_end-malloc_pre_main_ptr));
- malloc_pre_main_ptr+=size;
- recursive_malloc=0;
- return malloc_pre_main_ptr-size;
- } else
- malloc_pre_main_base=malloc_pre_main_ptr=malloc_pre_main_end=NULL;
+ if (!malloc_pre_main_base) {
+ massert((malloc_pre_main_base=mmap(NULL,s,PROT_READ|PROT_WRITE,MAP_PRIVATE|MAP_ANON,-1,0))!=(void *)-1);
+ malloc_pre_main_ptr=malloc_pre_main_base;
+ malloc_pre_main_end=malloc_pre_main_base+s;
+ }
+
+ size=(size+sizeof(max_align_t)-1)&~(sizeof(max_align_t)-1);
+ massert(size<=(malloc_pre_main_end-malloc_pre_main_ptr));
+
+ malloc_pre_main_ptr+=size;
+
+ return malloc_pre_main_ptr-size;
+
+}
+
+#define MALLOC_RETURN(_v) ({void *v=_v;recursive_malloc=0;return v;})
+
+static void *
+malloc_internal(size_t size) {
+
+ static bool recursive_malloc;
+
+ massert(!recursive_malloc);
+ recursive_malloc=1;
+
+ /*GCL originally strove to capture all malloc memory in its heap to avoid interference
+ with its heap growth in limited address range contexts. While static linking is still
+ possible, in most environments there will be external shared libraries in the address
+ space, and this is beneficial from a system performance perspective in any case. GCL
+ goes to significant lengths to detect mmap_base and move it out of the way where possible
+ to allow for maximum contiguous heap growth (e.g. just under 3Gb on 32bit systems at
+ present). Linking against libX11 at a minimum will call malloc before main via
+ constructors in that library. Likewise dlopen of GCL's libboot.so will malloc early,
+ but after main. Such calls as these have no effective cleanup routines available before
+ exit, and furthermore write aslr random data therein foiling reproducibility if saved
+ in the heap. Such would be useless dead space on reexec if stored there in any case.
+ Traditionally we called gcl_init_alloc here, and this works, but it seems more advisable
+ to ring fence the aslr/shared library world into its own domain and store such mallocs
+ outside the heap in non-reclaimable memory (ie. leaked). At present leak_malloc is only
+ used for the dlopen of libboot.so which is critical for a reproducible build, but wrapping
+ all dlopen thus may be advisable someday. Right now the image dumps from raw image
+ runs, and from saved images with GCL_NO_TRUENAME set and in which the run just loads
+ .o files and saves are reproducible, which is sufficient for Debian gcl dependencies:
+ hol88,maxima,acl2,fricas and axiom. CM 20260625*/
+
+ if (leak_malloc_p)
+ MALLOC_RETURN(leak_malloc(size));
CHECK_INTERRUPT;
malloc_list->c.c_car->st.st_self = alloc_contblock(size);
malloc_list->c.c_car->st.st_writable=writable_malloc;
- return(malloc_list->c.c_car->st.st_self);
+ MALLOC_RETURN(malloc_list->c.c_car->st.st_self);
}
object *p,pp;
- if (ptr == 0 || ptr < data_start || ptr >= core_end)
+ if (ptr == 0 || ptr < data_start || ptr >= (void *)core_end)
return;
for (p = &malloc_list,pp=*p; pp && !endp(pp); p = &((pp)->c.c_cdr),pp=pp->c.c_cdr)
void *
mdlopen(const char *name,int flags) {
- void *v=dlopen(name,flags);
+
+ void *v;
+ char *err;
+
+ set_leak_malloc_on();
+ v=dlopen(name,flags);
+ set_leak_malloc_off();
+ if ((err=dlerror()))
+ FEerror("dlopen failure on ~s: ~s",2,name,make_simple_string(err));
if (name) {
object x=sSAdlopen_handlesA->s.s_dbind;
for (;x!=Cnil && fix(x->c.c_car)!=(fixnum)v;x=x->c.c_cdr);
if (x==Cnil)
sSAdlopen_handlesA->s.s_dbind=MMcons(make_fixnum((fixnum)v),sSAdlopen_handlesA->s.s_dbind);
+ update_real_maxpage();
}
+
return v;
}
DEFUN("DLOPEN",object,fSdlopen,SI,1,1,NONE,OO,OO,OO,OO,(object name),"") {
- char *err;
- void *v;
-
dlerror();
name=coerce_to_string(name);
massert(snprintf(FN1,sizeof(FN1),"%-.*s",VLEN(name),name->st.st_self)>=0);
- v=dlopen(strlen(FN1) ? FN1 : 0,RTLD_LAZY|RTLD_GLOBAL);
- if ((err=dlerror()))
- FEerror("dlopen failure on ~s: ~s",2,name,make_simple_string(err));
- update_real_maxpage();
-
- RETURN1(make_fixnum((fixnum)v));
+ RETURN1(make_fixnum((fixnum)mdlopen(strlen(FN1) ? FN1 : 0,RTLD_LAZY|RTLD_GLOBAL)));
}
object sSterminal_interrupt;
+#if defined(__APPLE__)
+char *
+strerrordesc_np(int errnum) {
+ return (errnum >= 0 && errnum < sys_nerr) ? sys_errlist[errnum] : "Unknown error";
+}
+#endif
+
void
assert_error(const char *a,unsigned l,const char *f,const char *n) {
make_simple_string(a),make_fixnum(l),
make_simple_string(f),make_simple_string(n),make_simple_string(strerror(errno)));
else {
- emsg("The assertion %s on line %d of %s in function %s failed: %s",a,l,f,n,strerror(errno));
+ emsg("The assertion %s on line %d of %s in function %s failed: %s\n",a,l,f,n,strerrordesc_np(errno));
do_gcl_abort();
}
mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free);
jmp_gmp=0;
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt;
Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt;
Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt;
-#endif
}
char *system_directory;
-#define EXTRA_BUFSIZE 8
-char stdin_buf[BUFSIZ + EXTRA_BUFSIZE];
-char stdout_buf[BUFSIZ + EXTRA_BUFSIZE];
-char stderr_buf[BUFSIZ + EXTRA_BUFSIZE];
-
#include "stacks.h"
int debug; /* debug switch */
}
int initializing_boot=0;
+int in_pre_gcl=0;
void
init_boot(void) {
- char *sysd=getenv("GCL_SYSDIR"),*d=sysd ? sysd : kcl_self;
+ if (raw_image||in_pre_gcl) {
+
+ char *sysd=getenv("GCL_SYSDIR"),*d=sysd ? sysd : kcl_self;
#ifdef USE_LIBBOOT
- void *v,*q;
+ void *v,*q;
#endif
- char *z,*s="libboot.so";
- size_t m=sysd ? strlen(sysd) : dir_name_length(kcl_self),n=m+strlen(s)+1;
- object omp=sSAoptimize_maximum_pagesA->s.s_dbind;
+ char *z,*s="libboot.so";
+ size_t m=sysd ? strlen(sysd) : dir_name_length(kcl_self),n=m+strlen(s)+1;
+ object omp=sSAoptimize_maximum_pagesA->s.s_dbind;
- sSAoptimize_maximum_pagesA->s.s_dbind=Cnil;
- z=alloca(n);
- snprintf(z,n,"%-*.*s%s",(int)m,(int)m,d,s);
+ sSAoptimize_maximum_pagesA->s.s_dbind=Cnil;
+ z=alloca(n);
+ snprintf(z,n,"%-*.*s%s",(int)m,(int)m,d,s);
#ifdef USE_LIBBOOT
- if (!(v=mdlopen(z,RTLD_LAZY|RTLD_GLOBAL)))
- printf("%s\n",dlerror());
- if (!(q=dlsym(v,"gcl_init_boot")))
- printf("%s\n",dlerror());
+ if (!(v=mdlopen(z,RTLD_LAZY|RTLD_GLOBAL)))
+ printf("%s\n",dlerror());
+ if (!(q=dlsym(v,"gcl_init_boot")))
+ printf("%s\n",dlerror());
#endif
- initializing_boot=1;
+ initializing_boot=1;
#ifndef USE_LIBBOOT
- {
- extern void gcl_init_boot(void);
- gcl_init_boot();
- }
+ {
+ extern void gcl_init_boot(void);
+ gcl_init_boot();
+ }
#else
- ((void (*)())q)();
+ ((void (*)())q)();
#endif
- initializing_boot=0;
- sSAoptimize_maximum_pagesA->s.s_dbind=omp;
+ initializing_boot=0;
+ sSAoptimize_maximum_pagesA->s.s_dbind=omp;
+ }
+
+ set_leak_malloc_off();
}
-int in_pre_gcl=0;
object def_env1[2]={(object)1,Cnil},*def_env=def_env1+1;
object src_env1[2]={(object)1,Cnil},*src_env=src_env1+1;
ARGC = argc;
ARGV = argv;
ENVP = envp;
-
+
if (raw_image) {
printf("GCL (GNU Common Lisp) %s %ld pages\n",LISP_IMPLEMENTATION_VERSION,real_maxpage);
__stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/
#endif
- if (in_pre_gcl) init_boot();
+ init_boot();
}
#define RS_DEF_INIT 0
#endif
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
extern void * (*gcl_gmp_allocfun) (size_t);
static void * (*old_gcl_gmp_allocfun) (size_t);
static void * trap_result;
}
}
-#endif
void
reinit_gmp() {
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt;
Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt;
Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt;
-#endif
}
void
-init_gmp_rnd_state(__gmp_randstate_struct *x) {
+init_gmp_rnd_state(__gmp_randstate_struct *x,object rs) {
static int n;
bzero(x,sizeof(*x));
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
-/* if (!trap_size) { */
old_gcl_gmp_allocfun=gcl_gmp_allocfun;
gcl_gmp_allocfun=trap_gcl_gmp_allocfun;
-/* } */
-#endif
gmp_randinit_default(x);
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
if (!n) {
if (x->_mp_seed->_mp_d!=trap_result)
FEerror("Unknown pointer in rnd_state!",0);
-/* #ifndef __hppa__ /\*FIXME*\/ */
-/* if (((gmp_randfnptr_t *)x->_mp_algdata._mp_lc)->b!=Mersenne_Twister_Generator_Noseed.b || */
-/* ((gmp_randfnptr_t *)x->_mp_algdata._mp_lc)->c!=Mersenne_Twister_Generator_Noseed.c || */
-/* ((gmp_randfnptr_t *)x->_mp_algdata._mp_lc)->d!=Mersenne_Twister_Generator_Noseed.d) */
-/* FEerror("Unknown pointer data in rnd_state!",0); */
-/* #endif */
n=1;
}
gcl_gmp_allocfun=old_gcl_gmp_allocfun;
x->_mp_seed->_mp_alloc=x->_mp_seed->_mp_size=trap_size;
-#endif
-
+
+ if (rs == Ct)
+ gmp_randseed_ui(x,RS_DEF_INIT);
+ else if (type_of(rs)==t_random)
+ memcpy(x->_mp_seed->_mp_d,rs->rnd.rnd_state._mp_seed->_mp_d,
+ rs->rnd.rnd_state._mp_seed->_mp_alloc*sizeof(*x->_mp_seed->_mp_d));
+
+ x->_mp_algdata._mp_lc=&Mersenne_Twister_Generator_Noseed;
}
}
z = alloc_object(t_random);
- init_gmp_rnd_state(&z->rnd.rnd_state);
+ init_gmp_rnd_state(&z->rnd.rnd_state,rs);
-
- if (rs == Ct)
- gmp_randseed_ui(&z->rnd.rnd_state,RS_DEF_INIT);
- else
- memcpy(z->rnd.rnd_state._mp_seed->_mp_d,rs->rnd.rnd_state._mp_seed->_mp_d,
- rs->rnd.rnd_state._mp_seed->_mp_alloc*sizeof(*z->rnd.rnd_state._mp_seed->_mp_d));
-
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
- z->rnd.rnd_state._mp_algdata._mp_lc=&Mersenne_Twister_Generator_Noseed;
-#endif
return(z);
}
x = read_object(vs_base[0]);
tx=type_of(x);
vs_base[0] = alloc_object(t_random);
- init_gmp_rnd_state(&vs_base[0]->rnd.rnd_state);
-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2)
- vs_base[0]->rnd.rnd_state._mp_algdata._mp_lc=&Mersenne_Twister_Generator_Noseed;
-#endif
+ init_gmp_rnd_state(&vs_base[0]->rnd.rnd_state,Cnil);
if (tx!=t_fixnum || fix(x)) {
if (tx==t_fixnum) {
if (vs_base[0]->rnd.rnd_state._mp_seed->_mp_size!=1)
/*FIXME clean this up when done*/
+ set_leak_malloc_on();
+
set_global_env_defaults();
shared_lib_start=NULL;
+ memset(&fcall,0,sizeof(fcall));
memset(gmp_jmp,0,sizeof(gmp_jmp));
+ memset(stdin_buf,0,sizeof(stdin_buf));
+ memset(stdout_buf,0,sizeof(stdout_buf));
+ memset(stderr_buf,0,sizeof(stderr_buf));
memset(frs_org,0,(frs_limit-frs_org)*sizeof(*frs_org));
memset(bds_org,0,(bds_limit-bds_org)*sizeof(*bds_org));
memset(ihs_org,0,(ihs_limit-ihs_org)*sizeof(*ihs_org));
x=feenableexcept(x);
-#elif defined(__x86_64__) || defined(__i386__)
+#elif (defined(__x86_64__) && !defined(__gnu_hurd__)) || defined(__i386__)
#define ASM __asm__ __volatile__
{
volatile unsigned short s=0;
/* feclearexcept(FE_ALL_EXCEPT); */
x=fedisableexcept(FE_ALL_EXCEPT);
-#elif defined(__x86_64__) || defined(__i386__)
+#elif (defined(__x86_64__) && !defined(__gnu_hurd__)) || defined(__i386__)
#define ASM __asm__ __volatile__
{
volatile unsigned int i=0;